(define (loop? l)
  (let ((accessed-list '()))
    (define (recur l)
      (cond ((not (pair? l)) false)
            ((memq l accessed-list) true)
            (else (begin (set! accessed-list (cons l accessed-list))
                         (or (recur (car l))
                             (recur (cdr l)))))))
    (recur l)))

(define l1 '((a b) c d))
(loop? l1)
(set-cdr! (cddr l1) l1)
(loop? l1)

(define l2 '((a b c) c d))
(loop? l2)
(set-cdr! (cddr (car l2)) (car l2))
(loop? l2)